home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / lcpack.zip / TPACKMEM.PRG < prev   
Text File  |  1993-01-04  |  4KB  |  140 lines
  1. * Program Name: tpackmem.prg * 
  2. * Author: Don L. Powells * 
  3. * (c) 1987 by D. P. & Associates * 
  4. * Created: 8/21/1987 at 15:45 *
  5.  
  6. set color to w/b,b/w,b,b,w/b 
  7. clear 
  8. fname = space(64) 
  9. ? "                          TPACKMEM.PRG" 
  10. ? 
  11. ? "     This program demonstrates the mpack program written "+;
  12.         "in C." 
  13. ?"   mpack packs the dbt file holding the memos for the "+;
  14.      "specified dbf."
  15.  
  16. * Get filename
  17. @ 8,5 say "Enter a dbf filename with no extension: "  
  18. @ 9,5 get fname 
  19. read 
  20.  
  21. * Append proper extensions to filename
  22. dbffname = trim(fname) + ".dbf" 
  23. dbtname = trim(fname) + ".dbt" 
  24.  
  25. * Check to see if there is enough diskspace to execute the
  26. * function
  27. if diskspace(0) < filesize(dbtname)
  28.    ? chr(7)
  29.    ? "There is not enough disk space to safely execute this "+;
  30.      "function."
  31.    return
  32. endif
  33.  
  34. * Save the original files to temp files for use with mpack
  35. copy file &dbtname to temp#.dbt>nul 
  36. copy file &dbfname to temp#.dbf>nul 
  37.  
  38. * Pack the file with the COPY TO method
  39. @ 5,0 clear 
  40. @ 7,5 say "Packing " + trim(fname) + ".dbt. with COPY TO method." 
  41. stime = seconds() 
  42. use &fname 
  43. copy to temp 
  44. close databases 
  45. erase &dbfname 
  46. erase &dbtname 
  47. rename temp.dbf to &dbfname 
  48. rename temp.dbt to &dbtname 
  49. etime = seconds() 
  50. ?? chr(7) 
  51. run_time = etime - stime 
  52. ? alltrim(str(run_time)) 
  53. ?? " seconds elapsed." 
  54.  
  55. * Restore temp files to original files
  56. copy file temp#.dbt to &dbtname>nul 
  57. copy file temp#.dbt to &dbfname>nul 
  58.  
  59. * Pack using the mpack method
  60. oldsize = filesize(dbtname) 
  61. @ 9,5 say "Packing " + trim(fname) + ".dbt. with MPACK()." 
  62. stime = seconds() 
  63. errnum = mpack(trim(fname)) 
  64. etime = seconds() 
  65. run_time2 = etime - stime 
  66.  
  67. ?? chr(7) 
  68. ? "The error code returned by MPACK() is: " 
  69. ?? errnum 
  70. ?
  71.  
  72. * Translate the error code into a message 
  73. DO CASE 
  74.    case errnum = 0 
  75.       ? "The memo pack was successfully accomplished!!!" 
  76.    case errnum = 1 
  77.       ? " An improper number of parameters was passed or the "+;
  78.         "parameter " 
  79.       ? "    passed was not a character." 
  80.    case errnum = 2 
  81.       ? " The .dbf file could not be opened. There may not be "+;
  82.         "any file " 
  83.       ? "    handles available. The file may not exist. The "+;
  84.         "attributes may" 
  85.       ? "    be set to hidden." 
  86.    case errnum = 3 
  87.       ?" There was an error reading the signature byte of the "+;
  88.        ".dbf" 
  89.       ?"     header." 
  90.    case errnum = 4 
  91.       ? " The signature byte was not 83H. The .dbf file is a "+;
  92.         "dBASE file" 
  93.       ? "     with a memo field." 
  94.    case errnum = 5 
  95.       ? " There was a problem renaming the old .dbt file. "+;
  96.         "There may" 
  97.       ? "    already be a file in the current directory called " 
  98.       ? "    cpackmem.bak. The .dbt file may not be in the "+;
  99.         "current " 
  100.       ? "    directory." 
  101.    case errnum = 6 
  102.       ? " Can not open the old .dbt file." 
  103.    case errnum = 7 
  104.       ? " Can not create new .dbt file. There may be no file "+;
  105.         "handles " 
  106.       ? "    available. The disk may be full." 
  107.    case errnum = 8 
  108.       ? " Read error reading the first 512 bytes of the old "+;
  109.         ".dbt file." 
  110.    case errnum = 9 
  111.       ? " Write error writing the first 512 bytes of the new "+;
  112.         ".dbt file." 
  113.    case errnum = 10 
  114.       ? " Error moving pointer through .dbf file." 
  115.    case errnum = 11 
  116.       ? " Read error reading the .dbf header." 
  117.    case errnum = 12 
  118.       ? " Error moving pointer to first field descriptor in "+;
  119.         ".dbf file." 
  120.    case errnum = 13 
  121.       ? " Read error reading first field descriptor in .dbf "+;
  122.         "file." 
  123.    case errnum = 14 
  124.       ? " Read error reading a field descriptor in .dbf file." 
  125. endcase 
  126.  
  127. * Report results of function
  128. ? alltrim(str(run_time2)) 
  129. ?? " seconds elapsed when packing with MPACK()." 
  130. ? "MPACK requires "  
  131. ?? alltrim(str((run_time2/run_time)*100))+"% of the time "+;
  132.    "required by COPY TO method." 
  133. newsize = filesize(dbtname) 
  134. ? "Original file size= " + alltrim(str(oldsize)) + space(4) +; 
  135.    "New dbt file size= " + alltrim(str(newsize)) 
  136. saved = oldsize-newsize 
  137. ? alltrim(str(saved)) + " bytes were saved by packing." 
  138. wait 
  139. return 
  140.